CD Ware Multimedia 1994 November/Cd Ware (Nro. 2) - Epimundo.iso/DOS/PG/COMBOX.ZIP/STRLIB.PAS

Pascal/Delphi Source File | 1994-04-11 | 21.7 KB | 698 lines

Unit Strlib;

Interface

{uses
   Global,dos, LanGlob ;}

type
   StrPtr = ^string;
   AsciizType = array [ 0..255 ] of char;

procedure StrAddRight ( var TheStr : string ; SubStr : string ;
                            TheStrLimit : byte ) ;
procedure StrAddLeft ( SubStr : string ; var TheStr : string ;
                       TheStrLimit : byte ) ;
Function NewStr    ( S : string ) : StrPtr;
Function UpCaseStr ( S : string ) : string;
Function LRTrim    ( S : string ) : string;
Function LTrim     ( S : string ) : string;
Function RTrim     ( S : string ) : string;
Function LPad      ( S : string; Len : byte ) : string;
Function RPad      ( S : string; Len : byte ) : string;
Function CenterStr ( S : string; Width : byte ) : string;
Function StrToInt  ( S : string ) : longint;
Function IntToStr  ( I : longint ) : string;
Function RealToStr ( I : real; Digits, Decimals : integer ) : string;
Function StrToReal ( S : string; Digits, Decimals : integer  ) : real;
Function NumStr    ( S : string; Width : byte ) : string;
Function Spaces    ( Width : integer ) : string;
Function FillStr   ( Attr : char ; Size : byte ) : string ;
Function FillLine  ( WIdth : byte; First, Middle, Last : char ) : string;
Function ChFreq ( Ch : char; S : string ) : integer;
Function RPos ( Ch : char; S : string ) : integer;
Function StrToMask ( S : string; Mask : string ) : string;
Function StripMask ( S : string ) : string;

Procedure DisposeString ( StringPtr : StrPtr );
Procedure StrToAsciiz   ( S : string; var Asciiz : AsciizType );
Procedure AsciizToStr   ( Asciiz : AsciizType; var S : string );

Implementation

{========================================================================}

Function RPos ( Ch : char; S : string ) : integer;

var
   i : byte;
   Found : boolean;

Begin
   Found := false;
   i := length ( S ) + 1;
   while ( not Found ) and ( i > 0 ) do
      begin
      dec ( i );
      if S [ i ] = Ch then
         Found := true;
      end;
   RPos := i;
End;

{========================================================================}

Function ChFreq ( Ch : char; S : string ) : integer;

var
   i, Count : byte;

Begin
   Count := 0;
   for i := 1 to length ( S ) do
      if S [ i ] = Ch then
         inc ( Count );
   ChFreq := Count;
End;

{========================================================================}

procedure StrAddRight ( var TheStr : string ; SubStr : string ;
                            TheStrLimit : byte ) ; assembler ;

  { FAST string concatenator }
  { Almost 6 times faster than to say TheStr := TheStr + SubStr }

  { for passing a string, TheStrLimit should contain 255.     }
  { for passing a stringtype such as, for eg., string [ 10 ], }
  { TheStrLimit should contain 10 so, for safety's sake,      }
  { pass 'sizeof ( TheStr ) - 1' through TheStrLimit          }

asm
  mov   dx, ds                    { save data segment                         }
  push  es
  mov   al, TheStrLimit           { store maximum length of string allowed    }
  les   di, TheStr
  mov   bx, es:[di]
  cmp   bl, al                    { is there room left in TheStr to add?      }
  jae   @TheStrFull
  xor   bh, bh
  lds   si, SubStr
  mov   cx, ds:[si]
  or    cl, cl                    { is SubStr null?                           }
  jz    @TheStrFull
  inc   si
  sub   al, bl
  cmp   al, cl                    { is there room to add all of SubStr?       }
  jae   @RoomLeft
  mov   cl, al
@RoomLeft:
  xor   ch, ch
  add   es:[di], cl               { store new length of TheStr                }
  inc   di                        { take the length into account              }
  add   di, bx                    { position to end of TheStr                 }
  cld                             { we are moving forward                     }
  rep   movsb                     { transfer SubStr to TheStr                 }
@TheStrFull:
  pop   es
  mov   ds, dx                    { restore data segment                      }
end ;

{=============================================================================}

procedure StrAddLeft ( SubStr : string ; var TheStr : string ;
                       TheStrLimit : byte ) ; assembler ;

  { FAST string concatenator }
  { More than 2 times faster than to say TheStr := SubStr + TheStr }

  { for passing a string, TheStrLimit should contain 255.     }
  { for passing a stringtype such as, for eg., string [ 10 ], }
  { TheStrLimit should contain 10 so for safety's sake        }
  { pass 'sizeof ( TheStr ) - 1' through TheStrLimit          }

asm
  push  ds                        { save data segment                         }
  push  es
  mov   al, TheStrLimit           { store maximum length of string allowed    }
  les   di, TheStr
  mov   cx, es:[di]
  cmp   cl, al                    { is there room left in TheStr to add?      }
  jae   @TheStrFull
  lds   si, SubStr
  mov   bx, ds:[si]
  or    bl, bl                    { is SubStr null?                           }
  jz    @TheStrFull
  xor   bh, bh
  mov   dx, bx                    { store length for SubStr transfer          }
  sub   al, cl
  cmp   al, bl                    { is there room to add all of SubStr?       }
  jae   @RoomLeft
  mov   bl, al
@RoomLeft:
  add   bl, cl
  mov   es:[di], bl               { store new length of TheStr                }
  add   di, bx                    { position to end of new TheStr             }
  std                             { we are moving backwards                   }
  or    cl, cl                    { is length of TheStr zero?                 }
  jz    @TheStrNull
  xor   ch, ch
  lds   si, TheStr
  add   si, cx                    { position to end of TheStr                 }
  rep   movsb                     { transfer TheStr to TheStr                 }
  lds   si, SubStr
@TheStrNull:
  add   si, dx                    { position to end of SubStr                 }
  mov   cx, dx
  rep   movsb                     { transfer SubStr to TheStr                 }
@TheStrFull:
  pop   es
  pop   ds                        { restore data segment                      }
end ;

{=============================================================================}

function FillStr ( Attr : char ; Size : byte ) : string ; assembler ;

asm
  mov   bx, es
  les   di, @result
  cmp   Size, 0FFh
  jbe   @AssignWidth
  mov   cx, 0FFh
  jmp   NEAR PTR @Continue
@AssignWidth:
  mov   cl, Size
  xor   ch, ch
@Continue:
  mov   es:[di], cl
  inc   di
  cld
  mov   al, Attr
  rep   stosb
  mov   es, bx
end ;

{========================================================================}

Function FillLine ( Width : byte; First, Middle, Last : char ) : string; assembler;

asm
   mov   bx, es
   les   di, @result               { load destination register             }
   cld                             { we are moving forward                 }
   mov   al, Width                 { move desired width into AL            }
   stosb
   or    al, al
   jz    @DoneString
   xor   ch, ch
   mov   cl, al                    { we only want the low byte             }
   mov   al, First
   stosb                           { string [ 1 ] gets First               }
   dec   cl
   mov   al, Middle
@AllOfString:
   cmp   cl, 1                     { if at string [ TheWidth ] then        }
   je    @AssignLast               { get ready to assign Last              }
   stosb                           { else start assigning Middle to string }
   loop  @AllOfString
@AssignLast:
   mov   al, Last
   stosb                           { string [ TheWidth ] gets Last         }
@DoneString:
   mov   es, bx
end;

{========================================================================}

Procedure StrToAsciiz ( S : string; var Asciiz : AsciizType );

Begin
   move ( S [ 1 ], Asciiz [ 0 ], length ( S ) );
   Asciiz [ succ ( length ( S ) ) ] := #0;
End;

{========================================================================}

Procedure AsciizToStr ( Asciiz : AsciizType; var S : string );

var
   i : byte;

Begin
   i := 0;
   while Asciiz [ i ] <> #0 do
      inc ( i );

   move ( Asciiz [ 0 ], S [ 1 ], i );
   S [ 0 ] := chr ( i );
End;

{========================================================================}

Function NewStr ( S : string ) : StrPtr;

var
   StringPtr : StrPtr;

Begin
   getmem ( StringPtr, succ ( length ( S ) ) );
   StringPtr^ := S;
   NewStr := StringPtr;
End;

{========================================================================}

Function NumStr ( S : string; Width : byte ) : string;

const
  StrSize = sizeof ( string ) - 1;

var
   Str1, Str2 : string;
   i : byte;

Begin
   Str1 := '';
   Str2 := '';
   for i := length ( S ) downto 1 do
      begin
      if length ( Str1 ) = 3 then
         begin
         StrAddLeft ( ',' + Str1, Str2, StrSize );
         Str1 := ''
         end;
      StrAddLeft ( S [ i ], Str1, StrSize );
      end;
   StrAddLeft ( Str1, Str2, StrSize );
   NumStr := LPad ( Str2, Width );
End;

{========================================================================}

Procedure DisposeString ( StringPtr : StrPtr );

Begin
   freemem ( StringPtr, succ ( length ( StringPtr^ ) ) );
End;

{========================================================================}

Function CenterStr ( S : string; Width : byte ) : string; assembler;

asm
  mov   bx, ds                    { save data segment                      }
  push  es
  lds   si, S                     { load source register with S            }
  les   di, @result               { load destination register with @result }
  cld                             { we are moving forward                  }
  mov   cx, ds:[si]               { move length of S into cx               }
  xor   ch, ch                    { we only want the low byte              }
  mov   ah, Width
  cmp   cl, ah                    { if length of S >= Width then           }
  jae   @AssignAllOfString        { pass S through Center else             }
  inc   si
  mov   al, ah
  stosb                           { resulting length will be the width     }
  sub   ah, cl                    { subtract length of S from width        }
  test  ah, 1
  jz    @NotOdd
  inc   ah
@NotOdd:
  shr   ah, 1                     { divide by 2                            }
  mov   al, ' '                   { store space in AL                      }
  mov   dl, cl                    { store CL in DL                         }
  mov   cl, ah                    { for I := 1 to AH..                     }
  repnz stosb                     { store blank space in Center            }
  mov   cl, dl
  repnz movsb                     { now add string S to Center             }
  add   ah, dl                    { now add length of S to AH              }
  mov   cl, Width
  sub   cl, ah                    { subtract resulting AH from Width       }
  repnz stosb                     { finish off with blank spaces           }
  jmp   NEAR PTR @Finished
@AssignAllOfString:
  inc   cl                        { string has to include zeroth place     }
  repnz movsb
@Finished:
  pop   es
  mov   ds, bx                    { restore                                }
end ;

{========================================================================}

Function UpCaseStr ( S : string ) : string; assembler;

asm
  mov   bx, ds                    { save data segment                       }
  mov   dx, es
  lds   si, S                     { load source register with S             }
  les   di, @result               { load destination register               }
  cld                             { we are moving forward                   }
  movsb                           { resulting length will be the same       }
  mov   cx, ds:[si-1]             { move length of S into cx                }
  or    cl, cl                    { is it a zero?                           }
  jz    @IsNullString
  xor   ch, ch                    { we only want the low byte               }
@AllOfString:
  lodsb
  cmp   al, 'a'
  jb    @NextChar                 { if lower than 'a', read next character  }
  cmp   al, 'z'
  ja    @NextChar                 { if higher than 'z', read next character }
  sub   al, 'a' - 'A'             { else uppercase the character.           }
@NextChar:
  stosb                           { store source character to destination   }
  loop  @AllOfString
@IsNullString:
  mov   es, dx
  mov   ds, bx                    { restore                                 }
end ;

{========================================================================}

Function Spaces ( Width : integer ) : string; assembler;

asm    { function Spaces }
  push  es
  les   di, @RESULT
  cmp   Width, 0FFh
  jbe   @AssignWidth
  mov   cx, 0FFh
  jmp   NEAR PTR @Continue
@AssignWidth:
  mov   cx, Width
@Continue:
  mov   es:[di], cl
  inc   di
  cld
  mov   al, ' '
  rep   stosb
  pop   es
end ;  { function Spaces }

{========================================================================}

Function LPad ( S : string; Len : byte ) : string; assembler;

asm
  push  ds                        { save data segment                         }
  push  es
  lds   si, S                     { load source register with S               }
  les   di, @result               { load destination register                 }
  cld                             { we are moving forward                     }
  mov   cx, ds:[si]               { move length of S into cx                  }
  xor   ch, ch                    { we only want the low byte                 }
  mov   bl, Len
  inc   si
  mov   al, bl
  stosb                           { resulting length will be Len              }
  cmp   cl, bl                    { if length of S > Len then                 }
  ja    @AssignPartOfString       { pass Len amount of S through PadLeft else }
  sub   bl, cl                    { subtract length of S from Len             }
  mov   al, ' '                   { store space in AL                         }
  mov   dl, cl                    { store CL in DL                            }
  mov   cl, bl                    { for I := 1 to BL..                        }
  repnz stosb                     { store blank space in padded string        }
  mov   cl, dl
  repnz movsb                     { now add string S to padded string         }
  jmp   NEAR PTR @Finished
@AssignPartOfString:
  mov   cl, Len
  repnz movsb
@Finished:
  pop   es
  pop   ds                        { restore                                   }
End;

{========================================================================}

Function RPad ( S : string; Len : byte ) : string; assembler;

asm
  push  ds                        { save data segment                          }
  push  es
  lds   si, S                     { load source register with S                }
  les   di, @result               { load destination register                  }
  cld                             { we are moving forward                      }
  mov   cx, ds:[si]               { move length of S into cx                   }
  xor   ch, ch                    { we only want the low byte                  }
  mov   bl, Len
  inc   si
  mov   al, bl
  stosb                           { resulting length will be Len               }
  cmp   cl, bl                    { if length of S > Len then                  }
  ja    @AssignPartOfString       { pass Len amount of S through PadRight else }
  mov   dl, cl                    { store CL in DL                             }
  repnz movsb                     { add string S to padded string              }
  sub   bl, dl                    { subtract length of S from Len              }
  mov   al, ' '                   { store space in AL                          }
  mov   cl, bl                    { for I := 1 to BL..                         }
  repnz stosb                     { store blank space in padded string         }
  jmp   NEAR PTR @Finished
@AssignPartOfString:
  mov   cl, Len
  repnz movsb
@Finished:
  pop   es
  pop   ds                        { restore                             }
end ;

{========================================================================}

Function LRTrim ( S : string ) : string; assembler;

asm
  mov   bx, ds                    { save data segment                   }
  push  es
  lds   si, S                     { load source register with S         }
  les   di, @result               { load destination register           }
  mov   cl, ds:[si]               { move length of S into cx            }
  or    cl, cl                    { is it a zero?                       }
  jz    @AssignNullString
  xor   ch, ch                    { we only want the low byte           }
  mov   al, ' '                   { store space in AL                   }
@IsSpace:
  inc   si
  cmp   ds:[si], al
  loope @IsSpace                  { keep looping until it's not a blank }
  or    cl, cl
  jnz   @NotBlankString
  cmp   ds:[si], al               { last character could be a non-blank }
  je    @AssignNullString
@NotBlankString:
  inc   cl
  inc   di
  mov   dl, cl                    { store CL in DL                      }
  cld                             { we are moving forward               }
  repnz movsb                     { add string S to trimmed string      }
  dec   di
  mov   cl, dl
  std
  repe  scasb                     { while = to blank space              }
  inc   cl
  les   di, @result               { load destination register           }
@AssignNullString:
  mov   es:[di], cl               { move new length to trimmed string   }
  pop   es
  mov   ds, bx                    { restore                             }
end ;

{========================================================================}

Function LTrim ( S : string ) : string; assembler;

asm    { function TrimLeft }
  push  ds
  lds   si, S
  mov   cl, ds:[si]
  xor   ch, ch
  or    cl, cl
  jz    @AssignString
  mov   al, ' '
@LoopAgain:
  inc   si
  cmp   ds:[si], al
  loope @LoopAgain
  jz    @AssignString  { if last character wasn't a blank.. }
  inc   cl
@AssignString:
  push  es
  les   di, @RESULT
  mov   es:[di], cl
  inc   di
  cld
  rep   movsb
  pop   es
  pop   ds
end ;  { function TrimLeft }

{========================================================================}

Function RTrim ( S : string ) : string; assembler;

asm    { function RTrim }
  push  ds
  lds   si, S
  mov   cl, ds:[si]
  xor   ch, ch
  or    cl, cl
  jz    @AssignString
  mov   bx, cx
  inc   bx             { get ready for decrement in LoopAgain }
  mov   al, ' '
@LoopAgain:
  dec   bx
  cmp   ds:[si+bx], al
  loope @LoopAgain
  jz    @AssignString  { if last character wasn't a blank.. }
  inc   cl
  inc   si
@AssignString:
  push  es
  les   di, @RESULT
  mov   es:[di], cl
  inc   di
  cld
  rep   movsb
  pop   es
  pop   ds
end ;  { function RTrim }

{========================================================================}

Function StrToInt ( S : string ) : longint;

var
   Error : integer;
   Value : longint;

Begin
   val ( S, Value, Error );
   StrToInt := Value;
End;

{========================================================================}

Function IntToStr ( I : longint ) : string;

var
   Value : string;

Begin
   str ( I ,Value );
   IntToStr := Value;
End;

{========================================================================}

Function StrToReal ( S : string; Digits, Decimals : integer  ) : real;

var
   Error : integer;
   Value : real;

Begin
   val ( S, Value, Error );
   if Error = 0 then
      begin
      S := RealToStr ( Value, Digits, Decimals );
      val ( S, Value, Error );
      end;
   StrToReal := Value;
End;

{========================================================================}

Function RealToStr ( I : real; Digits, Decimals : integer ) : string;

var
   Value : string;

Begin
   str ( I:Digits:Decimals ,Value );
   RealToStr := Value;
End;

{========================================================================}
{ This needs work!
Function CleanNumStr ( S : string ) : string;

var
   i : integer;

Begin
   for i := 1 to length ( S ) do
      if not ( S [ i ] in [ '.', '0'..'9' ] ) then
         Delete ( S, i, 1 );
   CleanNumStr := S;
End;
}
{========================================================================}

Function StrToMask ( S : string; Mask : string ) : string;

var
   i : integer;
   Negative : boolean;

Begin
   S := LRTrim ( S );
   Negative := S [ 1 ] = '-';
   if Negative then
      S := copy ( S, 2, length ( S ) );

   { add commas }
   if pos ( ',', Mask ) <> 0 then
      begin
      { calc first comma pos }
      i := pos ( '.', S );
      if i = 0 then
         i := length ( S ) - 2
      else
         dec ( i, 3 );
      while i > 1 do
         begin
         Insert ( ',', S, i );
         dec ( i, 3 );
         end;
      end;

   { add a dollar sign }
   if pos ( '$', Mask ) <> 0 then
      S := '$' + S;

   { add a percent sign }
   if pos ( '%', Mask ) <> 0 then
      S := S + '%';

   { add a minus sign }
   if Negative then
      S := '-' + S;

   StrToMask := LPad ( S, length ( Mask ) );
End;

{========================================================================}

Function StripMask ( S : string ) : string;

const
   ValidChars = [ '0'..'9', '.', '-' ];

var
   St : string;
   i : integer;

Begin
   St := '';
   for i := 1 to length ( S ) do
      if S [ i ] in ValidChars then
         St := St + S [ i ];
   StripMask := St;
End;

{=============================================================================}

End.